home *** CD-ROM | disk | FTP | other *** search
/ Saar AMOK 2 / Saar AMOK II - Oktober 1994 (1994)(Kreativ Marketing)(DE)[!][I-7598].iso / disks / amok / amok_098 / checknonexportident / checknonexportident.mod < prev    next >
Text File  |  1993-10-07  |  26KB  |  818 lines
  1.  
  2. MODULE CheckNonExportIdent;
  3.  
  4. IMPORT
  5.   rq: Requests,
  6.   Break,
  7.   mes:Messages,
  8.   io,
  9.   arg: Arguments,
  10.   str: Strings, ms: MoreStrings,
  11.   fs: FileSystem;
  12.  
  13. VAR
  14.   modulenameWritten: BOOLEAN;
  15.   procLevel: INTEGER;
  16.   filename: ARRAY 256 OF CHAR;
  17.   file: fs.File;
  18.   Char* : CHAR;                      (* letztes Zeichen von ReadChar()        *)
  19.  
  20. CONST
  21.   versionString = "CheckNonExportIdent 1.0 (1.10.93) all Rights reserved";
  22.  
  23. PROCEDURE ReadOneChar();
  24. BEGIN
  25.   IF ~fs.ReadChar(file,Char) THEN Char := CHR(0); END;
  26. END ReadOneChar;
  27.  
  28. PROCEDURE ErrorOut(str: ARRAY OF CHAR);
  29. BEGIN
  30.   IF ~ modulenameWritten THEN
  31.     modulenameWritten := TRUE;
  32.     io.WriteString(filename);
  33.   END;
  34.   io.WriteString("  ***SyntaxError***"); io.WriteLn; HALT(10);
  35. END ErrorOut;
  36.  
  37. (* Alle Oberon Symbole: *)
  38.  
  39. CONST
  40.  
  41.   plus           * =  0; minus    * =  1; times      * =  2; divide      * =  3;
  42.   not            * =  4; and      * =  5; point      * =  6; comma       * =  7;
  43.   semicolon      * =  8; slash    * =  9; lparen     * = 10; langle      * = 11;
  44.   lbrace         * = 12; becomes  * = 13; power      * = 14; relation    * = 15;
  45.   equal          * = 16; range    * = 21; colon      * = 22;
  46.   rparen         * = 23;
  47.   rangle         * = 24; rbrace   * = 25; array      * = 26; begin       * = 27;
  48.   case           * = 28; close    * = 29; const      * = 30;
  49.   div            * = 32; do       * = 33; else       * = 34; elsif       * = 35;
  50.   end            * = 36; exit     * = 37; if         * = 38; module      * = 39;
  51.   import         * = 40; in       * = 41; is         * = 42; loop        * = 43;
  52.   mod            * = 44; of       * = 45; or         * = 46; pointer     * = 47;
  53.   procedure      * = 48; record   * = 49; repeat     * = 50; return      * = 51;
  54.   then           * = 52; to       * = 53; type       * = 54; var         * = 55;
  55.   until          * = 56; with     * = 57; while      * = 58; identifier  * = 59;
  56.   string         * = 60; cnumber  * = 61; cchar      * = 62; struct      * = 65;
  57.   bpointer       * = 66; for      * = 67; by         * = 68; untraced    * = 69;
  58.   eof            * = 80; none     * = 81; intstring  * = 82;
  59.   intpoint       * = 83; intnum   * = 84; intcomp    * = 85;
  60.   intid          * = 86; intparen * = 87; intcolon   * = 88;
  61.  
  62. (* none, intstring, intpoint, intnum, intcomp, intid, intparen und intcolon werden
  63.    nur intern in diesem Modul verwendet! *)
  64.  
  65. (* Allgemeiner Stringtyp: *)
  66.  
  67. TYPE
  68.   String * = ARRAY 80 OF CHAR;
  69.   StringPtr * = UNTRACED POINTER TO String;
  70.   LongStr * = ARRAY 512 OF CHAR;
  71.  
  72.  
  73. CONST
  74.   OpSize = 61;
  75.  
  76. TYPE
  77.   OpPtr = UNTRACED POINTER TO Opera;
  78.   Opera = STRUCT
  79.             name: ARRAY 10 OF CHAR;  (* Schlüsselwort *)
  80.             sym: INTEGER;     (* sein Symbol   *)
  81.             next: OpPtr;      (* nächstes mit gleichem Key *)
  82.           END;
  83.  
  84.   PROC = PROCEDURE;
  85.   ErrProc = PROCEDURE(str: ARRAY OF CHAR);
  86.  
  87. VAR
  88.  
  89.   Sym: INTEGER;                      (* letzes Symbol                         *)
  90.  
  91.   Operator: ARRAY OpSize OF OpPtr;   (* Hash-Tabelle der Schlüsselworte       *)
  92.   Syms: ARRAY 128 OF INTEGER;        (* Symbole, am 1. Zeichen erkannt        *)
  93.  
  94.   StdId: ARRAY OpSize OF OpPtr;      (* Hash-Tabelle der Standardbezeichner   *)
  95.  
  96.   i: INTEGER;      (* zum leeren der Hashtabelle beim Initialisieren *)
  97.   c: CHAR;
  98.  
  99.   ReadChar: PROC;
  100.   Error: ErrProc;
  101.   Identifier: String;
  102.   PreIdent: ARRAY 1024 OF CHAR;
  103.  
  104. PROCEDURE AppendPreIdent;
  105. VAR
  106. BEGIN
  107.   str.Append(PreIdent,Identifier);
  108.   str.AppendChar(PreIdent,".");
  109. END AppendPreIdent;
  110.  
  111. PROCEDURE ShortenPreIdent();
  112. VAR
  113.   pos: LONGINT;
  114. BEGIN
  115.   pos := ms.OccursCharPos(PreIdent,".",-(str.Length(PreIdent)-2));
  116.   IF pos >= 0 THEN
  117.     PreIdent[pos+1] := CHR(0);
  118.   ELSE
  119.     PreIdent := "";
  120.   END;
  121. END ShortenPreIdent;
  122.  
  123. (*-------------------------------------------------------------------------*)
  124.  
  125.  
  126. PROCEDURE GetKey*(VAR str: ARRAY OF CHAR): INTEGER;
  127.  
  128. VAR i,j,key: INTEGER;
  129.  
  130. BEGIN
  131.   i := 0; key := 0;
  132.   WHILE str[i]#0X DO
  133.     (* $OvflChk- *)
  134.       key := key * 256;
  135.       INC(key,ORD(str[i]));
  136.     (* $OvflChk= *)
  137.     INC(i);
  138.   END;
  139.   IF key<0 THEN IF key=MIN(INTEGER) THEN key := MAX(INTEGER) ELSE key := -key END END;
  140.   RETURN key;
  141. END GetKey;
  142.  
  143.  
  144. PROCEDURE GetOp*(VAR s: String): OpPtr;
  145. VAR
  146.   op: OpPtr;
  147. BEGIN
  148.   op := Operator[GetKey(s) MOD OpSize];
  149.   WHILE (op#NIL) AND (s#op.name) DO
  150.     op := op.next;
  151.   END;
  152.   RETURN op;
  153. END GetOp;
  154.  
  155. PROCEDURE GetStdId*(VAR s: String): OpPtr;
  156. VAR
  157.   op: OpPtr;
  158. BEGIN
  159.   op := StdId[GetKey(s) MOD OpSize];
  160.   WHILE (op#NIL) AND (s#op.name) DO
  161.     op := op.next;
  162.   END;
  163.   RETURN op;
  164. END GetStdId;
  165.  
  166.  
  167. (*-------------------------------------------------------------------------*)
  168.  
  169.  
  170. PROCEDURE GetSym*;
  171. (* Liest das nächste Symbol in die Variable Sym. *)
  172. VAR
  173.   c: CHAR;
  174.   done: BOOLEAN;
  175.  
  176.  (*------  Number:  ------*)
  177.  
  178.   PROCEDURE GetNumber;
  179.   (* wertet konstante Zahl aus. Bei Realzahlen wird der Bereich nicht geprüft! *)
  180.  
  181.   VAR hex: BOOLEAN;
  182.  
  183.   BEGIN
  184.     Sym := cnumber; hex := FALSE;
  185.     LOOP
  186.       CASE Char OF
  187.       "0".."9": |
  188.       "A".."F": hex := TRUE |
  189.       ELSE EXIT END;
  190.       ReadChar;
  191.     END;
  192.     CASE Char OF
  193.     "H","U": ReadChar; RETURN |
  194.     "X"    : ReadChar; Sym := cchar; RETURN |
  195.     ELSE END;
  196.     IF hex THEN Error(mes.EDfinkonst) END;
  197.     CASE Char OF
  198.     ".":
  199.       ReadChar; IF Char="." THEN Char := CHR(127); RETURN END;
  200.       WHILE (Char>="0") AND (Char<="9") DO ReadChar END;
  201.       CASE Char OF
  202.       "D","E":
  203.         ReadChar;
  204.         CASE Char OF "+","-": ReadChar ELSE END;
  205.         WHILE (Char>="0") AND (Char<="9") DO ReadChar END;
  206.       ELSE END;
  207.     ELSE END;
  208.   END GetNumber;
  209.  
  210.   (*------  Identifier:  ------*)
  211.  
  212.   PROCEDURE GetIdentifier;
  213.   (* liest Bezeichner ein *)
  214.  
  215.   VAR
  216.     cnt: INTEGER;   (* Anzahl Zeichen                *)
  217.     cap: BOOLEAN;   (* nur Großbuchstaben?           *)
  218.     cc: CHAR;
  219.     op: OpPtr;
  220.  
  221.   BEGIN
  222.     (* Identifier einlesen: *)
  223.     cnt := 0; cap := TRUE;  cc := CAP(Char);
  224.     REPEAT
  225.       cap := cap AND (cc=Char);
  226.       Identifier[cnt] := Char; ReadChar; cc := CAP(Char);
  227.       IF cnt<79 THEN INC(cnt) END;
  228.     UNTIL ((Char<"0") OR (Char>"9")) AND ((cc<"A") OR (cc>"Z"));
  229.     Identifier[cnt] := 0X;
  230.  
  231.     (* Probe auf reserviertes Wort: *)
  232.     IF cap THEN
  233.       op := GetOp(Identifier);
  234.       IF op#NIL THEN Sym := op.sym; RETURN END;
  235.     END;
  236.  
  237.     (* kein Standardbezeichner: *)
  238.     Sym := identifier;
  239.   END GetIdentifier;
  240.  
  241.   (*------  Bemerkung:  ------*)
  242.  
  243.   PROCEDURE Remark;
  244.  
  245.   BEGIN
  246.     ReadChar;
  247.     REPEAT
  248.       WHILE (Char#"*") AND (Char#0X) DO
  249.         IF Char="(" THEN ReadChar;
  250.           IF Char="*" THEN Remark() END
  251.         ELSE ReadChar END;
  252.       END;
  253.       ReadChar;
  254.     UNTIL (Char=")") OR (Char=0X);
  255.     IF Char=0X THEN Error(mes.EDendcomm) ELSE ReadChar END;
  256.   END Remark;
  257.  
  258.   PROCEDURE NoSpecialChar;
  259.   BEGIN
  260.     WHILE (Char<=" ") OR (Char>7FX) DO
  261.       IF Char=0X THEN RETURN END;
  262.       ReadChar;
  263.     END;
  264.   END NoSpecialChar;
  265.  
  266. BEGIN
  267.   REPEAT
  268.     NoSpecialChar;
  269.     Sym := Syms[ORD(Char)]; IF Sym<none THEN ReadChar; RETURN END;
  270.     CASE Sym OF
  271.     intid:  GetIdentifier |
  272.     intnum: GetNumber |
  273.     intparen: ReadChar; IF Char="*" THEN Remark; Sym:=none      ELSE Sym:=lparen END |
  274.     intpoint: ReadChar; IF Char="." THEN Sym:=range; ReadChar   ELSE Sym:=point  END |
  275.     intcolon: ReadChar; IF Char="=" THEN Sym:=becomes; ReadChar ELSE Sym:=colon  END |
  276.     intcomp:
  277.       Sym := relation; ReadChar; IF Char="=" THEN ReadChar END |
  278.     intstring:
  279.       c := Char;
  280.       done := FALSE;
  281.       REPEAT     (* String einlesen *)
  282.         IF Char="\\" THEN ReadChar END;
  283.         ReadChar;
  284.         IF Char=c THEN
  285.           ReadChar;
  286.           NoSpecialChar;
  287.           IF Char=c THEN ReadChar ELSE done := TRUE END;
  288.         END;
  289.       UNTIL done OR (Char=0AX);
  290.       CASE Char OF 0X,0AX: Error(mes.EDsteuinstr) ELSE END;
  291.       Sym := string |
  292.     none: Error(mes.EDunerwzei); ReadChar |
  293.     END;
  294.   UNTIL Sym#none;
  295. END GetSym;
  296.  
  297.  
  298. (*-------------------------------------------------------------------------*)
  299.  
  300.  
  301. PROCEDURE Parse* (rc: PROC; err: ErrProc);
  302. (*#   module  =  MODULE ident ";"  [ImportList] DeclarationSequence
  303.   #      [BEGIN StatementSequence] [CLOSE StatementSequence] END ident "." .
  304.   #  ImportList  =  IMPORT import {"," import} ";" .
  305.   #  import  =  identdef [":" ident]. *)
  306.  
  307.   PROCEDURE Check(sym: INTEGER; text: ARRAY OF CHAR);
  308.   BEGIN IF Sym#sym THEN Error(text) END; GetSym END Check;
  309.  
  310.   PROCEDURE CheckIdent;  BEGIN Check(identifier,mes.EDbezerw ) END CheckIdent;
  311.   PROCEDURE CheckSemi;   BEGIN Check(semicolon ,mes.EDsemierw) END CheckSemi;
  312.   PROCEDURE CheckColon;  BEGIN Check(colon     ,mes.EDcolerw ) END CheckColon;
  313.   PROCEDURE CheckEnd;    BEGIN Check(end       ,mes.EDenderw ) END CheckEnd;
  314.   PROCEDURE CheckOf;     BEGIN Check(of        ,mes.EDoferw  ) END CheckOf;
  315.   PROCEDURE CheckDo;     BEGIN Check(do        ,mes.EDdoerw  ) END CheckDo;
  316.   PROCEDURE CheckEqual;  BEGIN Check(equal     ,mes.EDglcherw) END CheckEqual;
  317.   PROCEDURE Checkrparen; BEGIN Check(rparen    ,mes.EDklzuerw) END Checkrparen;
  318.   PROCEDURE Checkrbrace; BEGIN Check(rbrace    ,mes.EDbrzuerw) END Checkrbrace;
  319.   PROCEDURE Checkrangle; BEGIN Check(rangle    ,mes.EDanzuerw) END Checkrangle;
  320.   PROCEDURE CheckThen;   BEGIN Check(then      ,mes.EDthenerw) END CheckThen;
  321.   PROCEDURE CheckTo;     BEGIN Check(to        ,mes.EDtoerw  ) END CheckTo;
  322.   PROCEDURE Times;       BEGIN IF Sym=times THEN GetSym END END Times;
  323.   PROCEDURE IdentDef;
  324.   (*#  identdef = ident ["*"|"-"].*)
  325.   BEGIN
  326.     CheckIdent;
  327.     CASE Sym OF
  328.       times,minus: GetSym
  329.     ELSE
  330.       IF procLevel = 0 THEN
  331.         IF ~ modulenameWritten THEN
  332.           modulenameWritten := TRUE;
  333.           io.WriteString(filename); io.WriteLn;
  334.         END;
  335.         io.WriteString("  "); io.WriteString(PreIdent);
  336.         io.WriteString(Identifier); io.WriteLn;
  337.       END;
  338.     END;
  339.   END IdentDef;
  340.   PROCEDURE Qualident;
  341.   (*#  qualident = [ident "."] ident.*)
  342.   BEGIN CheckIdent; IF Sym=point THEN GetSym; CheckIdent END END Qualident;
  343.  
  344.   PROCEDURE Semicolon(): BOOLEAN; BEGIN IF Sym=semicolon THEN GetSym; RETURN TRUE ELSE RETURN FALSE END END Semicolon;
  345.   PROCEDURE Comma():     BOOLEAN; BEGIN IF Sym=comma     THEN GetSym; RETURN TRUE ELSE RETURN FALSE END END Comma;
  346.  
  347.   PROCEDURE ^ Expression;
  348.  
  349.   PROCEDURE ExpList;
  350.   (*#  ExpList  =  expression {"," expression}. *)
  351.   BEGIN REPEAT Expression UNTIL NOT Comma() END ExpList;
  352.  
  353.   PROCEDURE Elements;
  354.   (*# Elements = element {"," element}.
  355.     # element = expression [".." expression]. *)
  356.   BEGIN
  357.     REPEAT
  358.       Expression; IF Sym=range THEN GetSym; Expression END;
  359.     UNTIL NOT Comma();
  360.   END Elements;
  361.  
  362.   PROCEDURE Set;
  363.   (*#  set  =  "{" [element {"," element}] "}".
  364.     #  element  =  expression [".." expression]. *)
  365.   BEGIN
  366.     GetSym; (* { *)
  367.     IF Sym#rbrace THEN Elements END;
  368.     Checkrbrace;
  369.   END Set;
  370.  
  371.   PROCEDURE Designator;
  372.   (*#  designator  =  qualident ( {"." ident | "[" ExpList "]" | "(" qualident ")" |
  373.                               "^" } | set ). !!! geändert für LONGSET{} etc. *)
  374.   BEGIN
  375.     Qualident;
  376.     LOOP
  377.       CASE Sym OF
  378.       point:  GetSym; CheckIdent |
  379.       langle: GetSym; ExpList; Checkrangle |
  380.       lparen: GetSym; IF Sym#rparen THEN ExpList END; Checkrparen |
  381.       power:  GetSym |
  382.       lbrace: Set |
  383.       ELSE EXIT END;
  384.     END;
  385.   END Designator;
  386.  
  387.   PROCEDURE Expression;
  388.   (*#  expression  =  SimpleExpression [relation SimpleExpression].
  389.     #  relation  =  "=" | "#" | "<" | "<=" | ">" | ">=" | IN | IS. *)
  390.  
  391.     PROCEDURE SimpleExpression;
  392.     (*#  SimpleExpression  =  ["+"|"-"] term {AddOperator term}.
  393.       #  AddOperator  =  "+" | "-" | OR . *)
  394.  
  395.       PROCEDURE Term;
  396.       (*#  term  =  factor {MulOperator factor}.
  397.         #  MulOperator  =  "*" | "/" | DIV | MOD | "&" . *)
  398.  
  399.         PROCEDURE Factor;
  400.         (*#  factor  =  number | CharConstant | string | NIL | set |
  401.           #    designator [ActualParameters] | "(" expression ")" | "~" factor. *)
  402.         BEGIN
  403.           CASE Sym OF
  404.           cnumber,cchar,string: GetSym |
  405.           identifier:           Designator |
  406.           lparen:               GetSym; Expression; Checkrparen |
  407.           not:                  GetSym; Factor |
  408.           lbrace:               Set |
  409.           ELSE Error(mes.EDfakterw) END;
  410.         END Factor;
  411.  
  412.       BEGIN
  413.         LOOP
  414.           Factor;
  415.           CASE Sym OF times,divide,div,mod,and: GetSym | ELSE EXIT END;
  416.         END;
  417.       END Term;
  418.  
  419.     BEGIN
  420.       CASE Sym OF plus,minus: GetSym | ELSE END;
  421.       LOOP
  422.         Term;
  423.         CASE Sym OF plus,minus,or: GetSym | ELSE EXIT END;
  424.       END;
  425.     END SimpleExpression;
  426.  
  427.   BEGIN
  428.     SimpleExpression;
  429.     CASE Sym OF equal,relation,in,is: GetSym; SimpleExpression ELSE END;
  430.   END Expression;
  431.  
  432.   PROCEDURE ^ StatementSequence;
  433.  
  434.   PROCEDURE StatSeqEnd; BEGIN StatementSequence; CheckEnd END StatSeqEnd;
  435.  
  436.   PROCEDURE ^ FormalParameters;
  437.  
  438.   PROCEDURE Type;
  439.   (*#  type  =  qualident | ArrayType | RecordType | PointerType | ProcedureType.
  440.     #  ArrayType  =  ARRAY [length {"," length}] OF type.
  441.     #  length  =  ConstExpression.
  442.     #  RecordType  =  RECORD ["(" BaseType ")"] FieldListSequence END.
  443.     #  BaseType  =  qualident.
  444.     #  FieldListSequence  =  FieldList {";" FieldList}.
  445.     #  FieldList  =  [IdentList ":" type].
  446.     #  PointerType  =  (BPOINTER | [UNTRACED] POINTER) TO type.
  447.     #  ProcedureType = PROCEDURE [FormalParameters]. *)
  448.   BEGIN
  449.     CASE Sym OF
  450.     identifier: Qualident |
  451.     array:      GetSym;
  452.                 IF Sym#of THEN
  453.                   Expression;
  454.                   WHILE Sym=comma DO
  455.                     GetSym;
  456.                     Expression
  457.                   END;
  458.                 END;
  459.                 CheckOf;
  460.                 Type |
  461.     record,struct:
  462.                 IF Sym=record THEN
  463.                   GetSym;
  464.                   IF Sym=lparen THEN GetSym; Qualident; Checkrparen END;
  465.                 ELSE
  466.                   GetSym;
  467.                   IF Sym=lparen THEN
  468.                     GetSym;
  469.                     IdentDef;
  470.                     CheckColon;
  471.                     Qualident;
  472.                     Checkrparen
  473.                   END;
  474.                 END;
  475.                 REPEAT
  476.                   IF Sym=identifier THEN
  477.                     REPEAT IdentDef; UNTIL NOT Comma();
  478.                     CheckColon; Type
  479.                   END;
  480.                 UNTIL NOT Semicolon();
  481.                 CheckEnd |
  482.     untraced,pointer,bpointer:
  483.                 IF Sym=untraced THEN
  484.                   GetSym; Check(pointer,mes.EDptrerw)
  485.                 ELSE
  486.                   GetSym
  487.                 END;
  488.                 CheckTo; Type |
  489.     procedure:  GetSym; FormalParameters;
  490.     ELSE Error(mes.EDtyperw) END;
  491.   END Type;
  492.  
  493.   PROCEDURE FormalParameters;
  494.   (*#  FormalParameters  =  "(" [FPSection {";" FPSection}] ")" [":" qualident].
  495.     #  FPSection  =  [VAR] ident ["{" Expression "}" [".."]] {"," ident} ":" Type. *)
  496.   BEGIN
  497.     IF Sym=lparen THEN
  498.       GetSym;
  499.       IF Sym#rparen THEN
  500.         IF Sym#lparen THEN
  501.           REPEAT
  502.             IF Sym=var THEN GetSym END;
  503.             REPEAT
  504.               CheckIdent;
  505.               IF Sym=lbrace THEN
  506.                 GetSym;
  507.                 Expression;
  508.                 Checkrbrace;
  509.                 IF Sym=range THEN GetSym END;
  510.               END;
  511.             UNTIL NOT Comma();
  512.             CheckColon; Type;
  513.           UNTIL NOT Semicolon();
  514.         END;
  515.       END;
  516.       Checkrparen;
  517.       IF Sym=colon THEN GetSym; Qualident END;
  518.     END;
  519.   END FormalParameters;
  520.  
  521.   PROCEDURE StatementSequence;
  522.   (*#  StatementSequence  =  statement {";" statement}. *)
  523.  
  524.     PROCEDURE Statement;
  525.     (*#  statement  =  [assignment | ProcedureCall |
  526.       #    IfStatement | CaseStatement | WhileStatement | RepeatStatement |
  527.       #    LoopStatement | WithStatement | ForStatement | EXIT | RETURN [expression] ].
  528.       #  assignment  =  designator ":=" expression.
  529.       #  ProcedureCall  =  designator [ActualParameters].
  530.       #  IfStatement  =  IF expression THEN StatementSequence
  531.       #    {ELSIF expression THEN StatementSequence}
  532.       #    [ELSE StatementSequence]
  533.       #    END.
  534.       #  CaseStatement  =  CASE expression OF case {"|" case} [ELSE StatementSequence] END.
  535.       #  case  =  [CaseLabelList ":" StatementSequence].
  536.       #  CaseLabelList  =  CaseLabels {"," CaseLabels}.
  537.       #  CaseLabels  =  ConstExpression [".." ConstExpression].
  538.       #  WhileStatement  =  WHILE expression DO StatementSequence END.
  539.       #  RepeatStatement  =   REPEAT StatementSequence UNTIL expression.
  540.       #  LoopStatement  =  LOOP StatementSequence END.
  541.       #  WithStatement  =  WITH qualident ":" qualident DO StatementSequence END .
  542.       #  ForStatement = FOR ident ":=" Expression TO Expression [BY ConstExpression]
  543.       #                 DO StatementSequence END. *)
  544.  
  545.       PROCEDURE ElseEnd;
  546.       BEGIN
  547.         IF Sym=else THEN GetSym; StatementSequence END;
  548.         CheckEnd;
  549.       END ElseEnd;
  550.  
  551.     BEGIN
  552.       CASE Sym OF
  553.       identifier: Designator; IF Sym=becomes THEN GetSym; Expression END |
  554.       if:         REPEAT
  555.                     GetSym; Expression; CheckThen; StatementSequence;
  556.                   UNTIL Sym#elsif;
  557.                   ElseEnd |
  558.       case:       GetSym; Expression; CheckOf;
  559.                   LOOP
  560.                     WHILE Sym=slash DO GetSym END;
  561.                     CASE Sym OF else,end: EXIT ELSE END;
  562.                     Elements; CheckColon; StatementSequence;
  563.                     IF Sym#slash THEN EXIT END;
  564.                   END;
  565.                   ElseEnd |
  566.       while:      GetSym; Expression; CheckDo; StatSeqEnd |
  567.       repeat:     GetSym; StatementSequence; Check(until,mes.EDuntilerw); Expression |
  568.       loop:       GetSym; StatSeqEnd |
  569.       with:       REPEAT
  570.                     GetSym; Qualident; CheckColon; Qualident; CheckDo; StatementSequence;
  571.                   UNTIL Sym#slash;
  572.                   ElseEnd |
  573.       for:        GetSym; CheckIdent; Check(becomes,mes.EDwirderw); Expression;
  574.                   CheckTo; Expression;
  575.                   IF Sym=by THEN GetSym; Expression END;
  576.                   CheckDo; StatSeqEnd |
  577.       exit:       GetSym |
  578.       return:     GetSym;
  579.                   CASE Sym OF semicolon,end,else,elsif,slash,until: |
  580.                   ELSE Expression END |
  581.       ELSE END;
  582.     END Statement;
  583.  
  584.   BEGIN
  585.     REPEAT
  586.       Statement;
  587.     UNTIL NOT Semicolon();
  588.   END StatementSequence;
  589.  
  590.   PROCEDURE DeclarationSequence;
  591.   (*#  DeclarationSequence  =  {CONST {ConstantDeclaration ";"} |
  592.     #      TYPE {TypeDeclaration ";"} | VAR {VariableDeclaration ";"}}
  593.     #      {ProcedureDeclaration ";" | ForwardDeclaration ";" |
  594.     #       ExternProcDeclaration ";"}.
  595.     #  ConstantDeclaration  =  identdef "=" ConstExpression.
  596.     #  ConstExpression  =  expression.
  597.     #  TypeDeclaration  =  identdef "=" type.
  598.     #  VariableDeclaration  =  IdentList ":" type.
  599.     #  ProcedureDeclaration  =  ProcedureHeading ";" ProcedureBody ident.
  600.     #  ProcedureHeading  =  PROCEDURE ["*"] [Receiver] identdef [FormalParameters].
  601.     #  ProcedureBody  =  DeclarationSequence [BEGIN StatementSequence] END.
  602.     #  ForwardDeclaration  =  PROCEDURE "^" [Receiver] identdef [FormalParameters].
  603.     #  Receiver = "(" [VAR] ident ":" ident ")".
  604.     #  ExternProcDeclaration = PROCEDURE identdef "[" expression ["," expression] "]" . *)
  605.  
  606.   VAR forward: BOOLEAN;
  607.  
  608.   BEGIN
  609.     LOOP
  610.       CASE Sym OF
  611.       | const: GetSym; WHILE Sym=identifier DO IdentDef; CheckEqual; Expression; CheckSemi END;
  612.       | type:  GetSym; WHILE Sym=identifier DO IdentDef; AppendPreIdent; CheckEqual; Type; CheckSemi; ShortenPreIdent; END;
  613.       | var:
  614.           GetSym;
  615.           WHILE Sym=identifier DO
  616.             REPEAT
  617.               IdentDef;
  618.               IF Sym=langle THEN GetSym; Expression; Checkrangle END;
  619.             UNTIL NOT Comma();
  620.             CheckColon; Type; CheckSemi;
  621.           END;
  622.       | procedure:
  623.           GetSym; forward := FALSE;
  624.           IF Sym=power THEN GetSym; forward := TRUE ELSE IF Sym=times THEN GetSym END END;
  625.           IF Sym=lparen THEN
  626.             GetSym;
  627.             IF Sym=var THEN GetSym END;
  628.             CheckIdent;
  629.             CheckColon;
  630.             CheckIdent;
  631.             Checkrparen;
  632.           END;
  633.           IdentDef;
  634.           INC(procLevel);
  635.           IF Sym=lbrace THEN
  636.             forward := TRUE;
  637.             GetSym;
  638.             Expression;
  639.             IF Sym=comma THEN GetSym; Expression END;
  640.             Checkrbrace;
  641.           END;
  642.           FormalParameters; CheckSemi;
  643.           IF NOT forward THEN
  644.             DeclarationSequence;
  645.             IF Sym=begin THEN GetSym; StatementSequence END;
  646.             CheckEnd; CheckIdent; CheckSemi;
  647.           END;
  648.           DEC(procLevel);
  649.       ELSE EXIT END;
  650.       ShortenPreIdent();
  651.     END;
  652.   END DeclarationSequence;
  653.  
  654. BEGIN
  655.   ReadChar := rc; Error := err; Char := " ";
  656.   GetSym;
  657.   REPEAT
  658.     Check(module,mes.EDmoderw); CheckIdent; CheckSemi;
  659.     IF Sym=import THEN
  660.       PreIdent := "IMPORT: ";
  661.       GetSym;
  662.       REPEAT
  663.         IdentDef; IF (Sym=colon) OR (Sym=becomes) THEN GetSym; CheckIdent END;
  664.       UNTIL NOT Comma();
  665.       CheckSemi;
  666.       PreIdent := "";
  667.     END;
  668.     DeclarationSequence;
  669.     IF Sym=begin THEN GetSym; StatementSequence END;
  670.     IF Sym=close THEN GetSym; StatementSequence END;
  671.     CheckEnd; CheckIdent; Check(point,mes.EDpkterw);
  672.   UNTIL Sym=eof;
  673. END Parse;
  674.  
  675.  
  676. (*-------------------------------------------------------------------------*)
  677.  
  678.  
  679. PROCEDURE AddOp(sym: INTEGER (* Symbol *); op: ARRAY OF CHAR);
  680. (* Operator zur Operatorenliste hinzufügen: *)
  681.  
  682. VAR
  683.   o: OpPtr;
  684.   i: INTEGER;
  685.  
  686. BEGIN
  687.   NEW(o); rq.Assert(o#NIL,mes.EDoom);
  688.   COPY(op,o.name);
  689.   o.sym  := sym;
  690.   i := GetKey(op) MOD OpSize;
  691.   o.next := Operator[i]; Operator[i] := o;
  692. END AddOp;
  693.  
  694.  
  695. PROCEDURE AddStd(op: ARRAY OF CHAR);
  696. (* Operator zur Operatorenliste hinzufügen: *)
  697.  
  698. VAR
  699.   o: OpPtr;
  700.   i: INTEGER;
  701.  
  702. BEGIN
  703.   NEW(o); rq.Assert(o#NIL,mes.EDoom);
  704.   COPY(op,o.name);
  705.   o.sym  := identifier;
  706.   i := GetKey(op) MOD OpSize;
  707.   o.next := StdId[i]; StdId[i] := o;
  708. END AddStd;
  709.  
  710.  
  711. BEGIN
  712.  
  713. (* Standardoperatoren: *)
  714.  
  715.   i := 0; WHILE i<OpSize DO Operator[i] := NIL; INC(i) END;
  716.   AddOp(and,      "AND"      ); AddOp(array,    "ARRAY"    );
  717.   AddOp(begin,    "BEGIN"    ); AddOp(bpointer, "BPOINTER" );
  718.   AddOp(by,       "BY"       ); AddOp(case,     "CASE"     );
  719.   AddOp(close,    "CLOSE"    ); AddOp(const,    "CONST"    );
  720.   AddOp(div,      "DIV"      ); AddOp(do,       "DO"       );
  721.   AddOp(else,     "ELSE"     ); AddOp(elsif,    "ELSIF"    );
  722.   AddOp(end,      "END"      ); AddOp(exit,     "EXIT"     );
  723.   AddOp(for,      "FOR"      ); AddOp(if,       "IF"       );
  724.   AddOp(import,   "IMPORT"   ); AddOp(in,       "IN"       );
  725.   AddOp(is,       "IS"       ); AddOp(loop,     "LOOP"     );
  726.   AddOp(mod,      "MOD"      ); AddOp(module,   "MODULE"   );
  727.   AddOp(not,      "NOT"      ); AddOp(of,       "OF"       );
  728.   AddOp(or,       "OR"       ); AddOp(pointer,  "POINTER"  );
  729.   AddOp(procedure,"PROCEDURE"); AddOp(record,   "RECORD"   );
  730.   AddOp(repeat,   "REPEAT"   ); AddOp(return,   "RETURN"   );
  731.   AddOp(struct,   "STRUCT"   ); AddOp(then,     "THEN"     );
  732.   AddOp(to,       "TO"       ); AddOp(type,     "TYPE"     );
  733.   AddOp(until,    "UNTIL"    ); AddOp(untraced, "UNTRACED" );
  734.   AddOp(var,      "VAR"      ); AddOp(while,    "WHILE"    );
  735.   AddOp(with,     "WITH"     );
  736.  
  737.   AddStd("BOOLEAN" );
  738.   AddStd("CHAR"    );
  739.   AddStd("BYTE"    );
  740.   AddStd("SHORTINT");
  741.   AddStd("INTEGER" );
  742.   AddStd("LONGINT" );
  743.   AddStd("REAL"    );
  744.   AddStd("LONGREAL");
  745.   AddStd("SHORTSET");
  746.   AddStd("LONGSET" );
  747.   AddStd("SET"     );
  748.  
  749.   AddStd("FALSE"   );
  750.   AddStd("TRUE"    );
  751.   AddStd("NIL"     );
  752.  
  753.   AddStd("ABS"     );
  754.   AddStd("ASH"     );
  755.   AddStd("CAP"     );
  756.   AddStd("CHR"     );
  757.   AddStd("COPY"    );
  758.   AddStd("DEC"     );
  759.   AddStd("DISPOSE" );
  760.   AddStd("ENTIER"  );
  761.   AddStd("EXCL"    );
  762.   AddStd("HALT"    );
  763.   AddStd("INC"     );
  764.   AddStd("INCL"    );
  765.   AddStd("LEN"     );
  766.   AddStd("LONG"    );
  767.   AddStd("MAX"     );
  768.   AddStd("MIN"     );
  769.   AddStd("NEW"     );
  770.   AddStd("ODD"     );
  771.   AddStd("ORD"     );
  772.   AddStd("SHORT"   );
  773.   AddStd("SIZE"    );
  774.  
  775.   AddStd("SYSTEM"  );
  776.   AddStd("ADR"     );
  777.   AddStd("LSH"     );
  778.   AddStd("ROT"     );
  779. (*AddStd("SIZE"    ); s.o. *)
  780.   AddStd("INIT"    );
  781.   AddStd("INLINE"  );
  782.   AddStd("REG"     );
  783.   AddStd("SETREG"  );
  784.   AddStd("VAL"     );
  785.   AddStd("ADDRESS" );
  786.   AddStd("TYPEDESC");
  787.  
  788.   Syms[ORD("!")]:=none;     Syms[ORD('"')]:=intstring; Syms[ORD("#")]:=relation;
  789.   Syms[ORD("$")]:=none;     Syms[ORD("%")]:=none;      Syms[ORD("&")]:=and;
  790.   Syms[ORD("'")]:=intstring;Syms[ORD("(")]:=intparen;  Syms[ORD(")")]:=rparen;
  791.   Syms[ORD("*")]:=times;    Syms[ORD("+")]:=plus;      Syms[ORD(",")]:=comma;
  792.   Syms[ORD("-")]:=minus;    Syms[ORD(".")]:=intpoint;  Syms[ORD("/")]:=divide;
  793.   Syms[ORD(":")]:=intcolon; Syms[ORD(";")]:=semicolon; Syms[ORD("<")]:=intcomp;
  794.   Syms[ORD("=")]:=equal;    Syms[ORD(">")]:=intcomp;   Syms[ORD("?")]:=none;
  795.   Syms[ORD("@")]:=none;     Syms[ORD("[")]:=langle;    Syms[ORD("\\")]:=none;
  796.   Syms[ORD("]")]:=rangle;   Syms[ORD("^")]:=power;     Syms[ORD("_")]:=none;
  797.   Syms[ORD("`")]:=none;     Syms[ORD("{")]:=lbrace;    Syms[ORD("|")]:=slash;
  798.   Syms[ORD("}")]:=rbrace;   Syms[ORD("~")]:=not;       Syms[127     ]:=range;
  799.   Syms[0       ]:=eof;
  800.  
  801.   c := "0"; REPEAT Syms[ORD(c)] := intnum; INC(c) UNTIL c>"9";
  802.   c := "A"; REPEAT Syms[ORD(c)] := intid;  INC(c) UNTIL c>"Z";
  803.   c := "a"; REPEAT Syms[ORD(c)] := intid;  INC(c) UNTIL c>"z";
  804.  
  805.   filename := versionString;
  806.   arg.GetArg(1,filename);
  807.   IF fs.Open(file,filename,FALSE) THEN
  808.     Parse(ReadOneChar,ErrorOut);
  809.     IF fs.Close(file) THEN END;
  810.     IF modulenameWritten THEN HALT(5); END;
  811.   ELSE
  812.     io.WriteString("***Error opening file "); io.WriteString(filename); io.WriteLn;
  813.     HALT(20);
  814.   END;
  815.  
  816. END CheckNonExportIdent.
  817.  
  818.